;;; Write tab seperated data to an excel XML file

(defpackage "EXCEL"
  (:use cl)
  (:export #:with-document #:with-sheet #:write-row #:write-cell #:with-row #:write-column #:write-formula))
(in-package "EXCEL")

(defvar *excel-stream* nil
  "Excel dump stream.")

(defun clean-string (string)
  ""
  (with-output-to-string (s)
    (loop for i across string do
          (case i
            (#\< (write-string "&lt;" s))
            (#\> (write-string "&gt;" s))
            (t (write-char i s))))))

(defun doc-header (&optional (stream *excel-stream*))
  (write-line "<?xml version=\"1.0\"?>
<Workbook xmlns=\"urn:schemas-microsoft-com:office:spreadsheet\"
 xmlns:o=\"urn:schemas-microsoft-com:office:office\"
 xmlns:x=\"urn:schemas-microsoft-com:office:excel\"
 xmlns:html=\"http://www.w3.org/TR/REC-html40\"
 xmlns:ss=\"urn:schemas-microsoft-com:office:spreadsheet\">
 <DocumentProperties xmlns=\"urn:schemas-microsoft-com:office:office\">
  <Author>Master Betts</Author>
  <LastAuthor>Master Betts</LastAuthor>
  <Created>2006-12-08T02:38:16Z</Created>
  <Version>11.768</Version>
 </DocumentProperties>
 <OfficeDocumentSettings xmlns=\"urn:schemas-microsoft-com:office:office\">
  <AllowPNG/>
 </OfficeDocumentSettings>
 <ExcelWorkbook xmlns=\"urn:schemas-microsoft-com:office:excel\">
  <WindowHeight>19000</WindowHeight>
  <WindowWidth>29600</WindowWidth>
  <WindowTopX>-20</WindowTopX>
  <WindowTopY>-20</WindowTopY>
  <ActiveSheet>2</ActiveSheet>
  <Date1904/>
  <AcceptLabelsInFormulas/>
  <ProtectStructure>False</ProtectStructure>
  <ProtectWindows>False</ProtectWindows>
 </ExcelWorkbook>
 <Styles>
  <Style ss:ID=\"Default\" ss:Name=\"Normal\">
   <Alignment ss:Vertical=\"Bottom\"/>
   <Borders/>
   <Font ss:FontName=\"Verdana\"/>
   <Interior/>
   <NumberFormat/>
   <Protection/>
  </Style>
 </Styles>" stream))

(defun doc-footer (&optional (stream *excel-stream*))
  (write-line "</Workbook>" stream))

(defun sheet-header (name &optional (stream *excel-stream*))
  (format stream " <Worksheet ss:Name=\"~a\">
  <Table>
" (clean-string name)))

(defun sheet-footer (&optional (stream *excel-stream*))
  (write-line "  </Table>
  <WorksheetOptions xmlns=\"urn:schemas-microsoft-com:office:excel\">
   <Print>
    <ValidPrinterInfo/>
    <PaperSizeIndex>0</PaperSizeIndex>
    <HorizontalResolution>-4</HorizontalResolution>
    <VerticalResolution>-4</VerticalResolution>
   </Print>
   <PageLayoutZoom>100</PageLayoutZoom>
   <ProtectObjects>False</ProtectObjects>
   <ProtectScenarios>False</ProtectScenarios>
  </WorksheetOptions>
 </Worksheet>" stream))

(defun excel-type (thing)
  (typecase thing
      (number "Number")
    (t "String")))

(defun excel-format (thing)
  (typecase thing
    (number (format nil "~,2f" thing))
    (null "")
    (string (clean-string thing))
    (t thing)))

(defmacro with-row (&body body)
  `(progn
     (write-line " <Row>" *excel-stream*)
     ,@body
     (write-line "</Row>" *excel-stream*)))

(defun write-column (n &key width)
  (format *excel-stream*
          "<Column ss:Index=\"~d\" ss:AutoFitWidth=\"0\" ~{~a~^ ~}/>~%"
          n
          (when width
            (list (format nil "ss:Width=\"~a\"" width)))))

(defun write-cell (cell)
  (format *excel-stream* "    <Cell><Data ss:Type=\"~a\">~a</Data></Cell>~%" 
          (excel-type cell)
          (excel-format cell)))

(defun write-formula (formula data)
  (format *excel-stream* "    <Cell ss:Formula=\"~a\"><Data ss:Type=\"~a\">~a</Data></Cell>~%" 
          (excel-format formula)
          (excel-type data)
          (excel-format data)))

(defun write-row (&rest columns)
  (let ((stream *excel-stream*))
    (write-line " <Row>" stream)
    (loop for i in columns do
         (format stream "    <Cell><Data ss:Type=\"~a\">~a</Data></Cell>~%" 
                 (excel-type i)
                 (excel-format i)))
    (write-line "</Row>" stream)))

(defmacro with-document (file &body body)
  `(with-open-file (*excel-stream* ,file
                                   :direction :output
                                   :if-exists :supersede
                                   :if-does-not-exist :create)
     (doc-header)
     ,@body
     (doc-footer)))

(defmacro with-sheet (name &body body)
  `(progn
     (sheet-header ,name)
     ,@body
     (sheet-footer)))


(defun test-it ()
  (with-document "test.xml"
    (with-sheet "b>o<b"
        (write-row 3 "a<b>c" 3.4 6.5 100 "123")
        (write-row 8 1 2 3 4 5 6 7 8 9))
    (with-sheet "bletch"
        (write-row 1 0 9 8 7 6)
        (write-row 10 6 78 12 4 7 8))))
 